home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0921.ZIP / GRSEAR.ARC / GRSEARCH.PAS < prev   
Pascal/Delphi Source File  |  1987-12-25  |  9KB  |  267 lines
  1. program grsearch;
  2. { Author: 
  3.    12/26/87       Michael Shunfenthal  Compuserve ID [76320,122]
  4.  
  5. program function: (This routine replaces the procedure InitGraph)
  6.    1. find the graphics display type and the driver in any
  7.       directory listed in the PATH environment variable. 
  8.    2. initialize graphics mode with the appropriate driver in that 
  9.       directory. 
  10. }
  11.  
  12. uses dos,crt,graph;
  13.  
  14. const
  15.   TotalPaths = 20;        { max number of directories in the path }
  16.  
  17. type
  18.    bytepatharray = Array [1..TotalPaths, 1..64] of Byte;
  19.    maxdirtype = 1..TotalPaths;
  20.  
  21. var
  22.    pc,                    { when searching: character-in-path counter }
  23.    graphstatus, GraphDriver, GraphMode   : integer;
  24.    listdirstring: string [64];
  25.    bgifile : string [8];
  26.  
  27. procedure graphicsstartup; {define the bgi file to be found}
  28.  
  29. begin
  30.    GraphDriver := Detect;          {detect and return current adapter}
  31.    DetectGraph(GraphDriver, GraphMode );
  32.    case GraphDriver of             {set the BGI file to be found}
  33.       Reserved,
  34.       CGA      : bgifile := 'CGA';
  35.       MCGA,
  36.       EGA, EGA64, EGAMono,
  37.       VGA      : bgifile := 'EGAVGA';
  38.       Hercmono : bgifile := 'HERC';
  39.       ATT400   : bgifile := 'ATT';
  40.       PC3270   : bgifile := 'PC3270';
  41.    end;
  42.    graphstatus := GraphResult;
  43.    if graphstatus > grOk then      { call this function to test result}
  44.       begin
  45.          writeln('Graphics init error: ', graphstatus);
  46.          Halt(1);
  47.       end;
  48. end; { graphicsstartup }
  49.  
  50. procedure searchenvironment ( var dircount : maxdirtype;
  51.            var dirlist : bytepatharray );
  52.  
  53. var
  54.    Segment,               { the two parts of an address }
  55.    offset,
  56.    offsetvarstart : Integer; { offset wher the 'P' in PATH... begins }
  57.  
  58. Procedure Get_PSP; { get the program segment prefix }
  59. var
  60.    Regs                 : Registers;
  61.    PSP                  : Integer;
  62.  
  63. Begin
  64.    Regs.AX :=  $6200;         { Get PSP address    }
  65.    MsDos (Regs);              { Call DOS, int 0x21 }
  66.    PSP := Regs.BX;            { BX has our PSP     }
  67.    Segment := MemW[PSP:$2C];  { the offset of $2C indicates the starting
  68.                                place in memory of our current environment
  69.                                string }
  70. End; { Get_PSP }
  71.  
  72. Procedure Read_Env;
  73. { read the environment area, searching for variables delimited by a null }
  74.  
  75. procedure locatevariable;
  76. { search for the specified variable: 'PATH'}
  77.  
  78. begin
  79. { parse argument, process search sequentially }
  80.    if (Mem[Segment:offset] = ord('P'))    and
  81.       (Mem[Segment:offset+1] = ord('A'))  and
  82.       (Mem[Segment:offset+2] = ord('T'))  and
  83.       (Mem[Segment:offset+3] = ord('H'))
  84.          then
  85.             offsetvarstart:=offset;   { mark where variable begins in memory }
  86. end; { locatevariable }
  87.  
  88. Begin { Read_Env }
  89.    offset := -1;              { set initial offsets }
  90.    offsetvarstart := -1;
  91.    ClrScr;
  92. {   writeln('The DOS environment variables: '); }
  93.    While (offset < 32000) do   { stop after reading the first 1000
  94.                                 characters of the DOS environment }
  95.       begin
  96.          offset := offset + 1;   { increment the offset by one             }
  97.          { call locatevariable to see if it is the first variable
  98.            in the environment }
  99.          if offset = 0 then locatevariable;
  100.          if Mem[Segment:offset] = 0  then
  101.             begin
  102.                if Mem[Segment:offset+1] = 0 then
  103.                   begin
  104.             { two nulls in a row indicate the end of the environment.  }
  105. {            writeln;
  106.             writeln('The DOS environment is ',offset,' bytes long.',
  107.                '  PATH located at offset: ', offsetvarstart);  }
  108.             exit
  109.                   end
  110.                else     { a single null indicates the end of one variable,
  111.                           so the call to locatevariable will not find one
  112.                           as part of another }
  113.                   begin
  114.                      offset := offset + 1;
  115.                      locatevariable;
  116.                      offset := offset - 1;
  117. {                     writeln; }
  118.                   end
  119.             end
  120.          else  { not a null }
  121.             begin
  122. {            write(chr(Mem[Segment:offset]));} { print any value but 0 (null) }
  123.             end
  124.   End;  { end while loop }
  125. End;  { Read_Env }
  126.  
  127. Procedure StorePath;
  128. { search for each directory delimited by a ';' and store it in an array }
  129.  
  130. var
  131.    Newoff : integer;
  132.  
  133. Begin                 { initialize the array to nulls }
  134.    for pc := 1 to TotalPaths do FillChar(dirlist,255,0);
  135.    pc  := 0;
  136.    dircount := 1;
  137. { Found PATH= thus first 5 bytes are PATH= so skip it, then parse by ; }
  138.    Newoff := offsetvarstart+5;   { see skip message above }
  139.    While Newoff< offsetvarstart+1000 do  { presuming PATH is smaller than 1000 chars }
  140.     begin
  141.       if Mem[Segment:NewOff]=0 then
  142.          Newoff:=offsetvarstart+1024        { null found, so PATH Search is Complete }
  143.       else
  144.       if Mem[Segment:Newoff] in [33..41,44..59,61,64..90,92] then
  145.                                    { are they allowable directory chars?  }
  146.       if Mem[Segment:Newoff] in [59] then { [59] is the ';', the PATH delim }
  147.          begin                             { end of one subdirectory }
  148.           if dircount = TotalPaths then
  149.             begin
  150.               writeln('Too many Paths encountered... exiting');
  151.               Halt(1);               { return to DOS with ErrorLevel set to 1 }
  152.             end;
  153.           pc := 0; dircount := dircount+1;     { reset char, increment directory counts }
  154.          end
  155.        else
  156.          begin                       { save the path character in an array }
  157.           pc := pc+1;
  158.           dirlist[dircount][pc]:=Mem[Segment:Newoff];
  159.          end;
  160.       Newoff := Newoff + 1;
  161.      end;
  162. end; { StorePath }
  163.  
  164. Procedure ListPath;
  165.           { display each directory in the path }
  166. var
  167.    a,                 { when displaying: character-in-path counter }
  168.    b : integer;       { when displaying: number-of-directories counter }
  169.  
  170. begin
  171. writeln;
  172. writeln('Number of PATH directories: ', dircount, '.  Your current path is:');
  173. { print each directory in the path on a new line }
  174. If dircount > 1
  175.    Then
  176.       For a:=1 to dircount do   { a counts directories in the array }
  177.         begin
  178.           b:=1;            { b counts characters (first index) in the array }
  179.           While b < 255 do
  180.              if dirlist[a][b] in [32..95] then
  181.                 begin
  182.                   { it is a printable char }
  183.                    write(chr(dirlist[a][b]));
  184.                    b:=b+1;
  185.                 end
  186.              else          { it is NOT printable...        }
  187.                 b:=256;    { something to get out of while loop }
  188.           writeln; { a new line }
  189.        end { of for loop }
  190.    else
  191.       writeln('No PATH variable in the environment');
  192. end;  { ListPath }
  193.  
  194. Begin {searchenvironment}
  195.    Get_PSP;
  196.    Read_Env;
  197.    if offsetvarstart > -1 then
  198.       begin      { if offsetvarstart has not been changed from its initial }
  199.          StorePath; { setting to -1, then the variable has not been found }
  200.          ListPath;
  201.       end
  202.    else
  203.       writeln ('No path found');
  204. End; {searchenvironment}
  205.  
  206. procedure bgifind; { search for the given bgifile }
  207.  
  208. label
  209.    1000;
  210. var
  211.    listdirbyte : bytepatharray;
  212.    maxdirs, countdirs : maxdirtype;
  213.    countbyte : integer;
  214.    filerecord : searchrec;
  215.  
  216. begin { bgifind }
  217.    searchenvironment (maxdirs, listdirbyte);
  218.    { convert the byte array into an input for findfirst }
  219.    if maxdirs > 0 then
  220.    for countdirs := 1 to maxdirs do
  221.       begin
  222.       listdirstring := '';
  223.       for countbyte := 1 to 64 do
  224.          begin
  225.          { starting with the left end of the byte array, stuff the
  226.          character equivalent into the single string variable listdirchar
  227.          until the first null is reached.  At that byte, substitute a
  228.          '\' if the last character wasn't already a '\',
  229.          and record the byte number for that array index in enddir }
  230.             if listdirbyte[countdirs, countbyte] <> 0 then
  231.                listdirstring := listdirstring +
  232.                  chr (listdirbyte[countdirs, countbyte])
  233.              else {null byte: end of directory path }
  234.                 if copy (listdirstring, length (listdirstring), 1)<>'\' then
  235.                    begin
  236.                       listdirstring := listdirstring + '\';
  237.                       goto 1000;
  238.                    end;
  239.          end;
  240. 1000:    findfirst ( listdirstring+bgifile+'.bgi', anyfile, filerecord);
  241.          if doserror = 0 then
  242.             begin
  243.             writeln ( 'Found: ', listdirstring+bgifile+'.bgi');
  244.             exit;
  245.             end
  246.          else
  247.             writeln ( 'Did not find: ', listdirstring+bgifile+'.bgi',
  248.                       ' Dos error: ', doserror );
  249.       end;
  250. end; { bgifind }
  251.  
  252. begin {main procedure}
  253. graphicsstartup;
  254. bgifind;
  255. writeln ('(press <return>)');readln;
  256. InitGraph (Graphdriver, Graphmode, listdirstring);
  257. graphstatus := GraphResult;
  258. if graphstatus <> grOk then
  259.    begin
  260.       writeln ('Graphics init error: ', graphstatus);
  261.       Halt(1);
  262.    end;
  263. outtextxy ( 0, 20, 'I HAVE DONE IT! (press <return>)');
  264. readln;
  265. CloseGraph;
  266. end. {main procedure}
  267.